home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / interp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  25.0 KB  |  1,102 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: interp.c,v 1.19 94/11/29 06:43:03 wlott Exp $
  27. *
  28. * This file implements the actual byte interpreter.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "gc.h"
  36. #include "thread.h"
  37. #include "driver.h"
  38. #include "func.h"
  39. #include "bool.h"
  40. #include "list.h"
  41. #include "class.h"
  42. #include "obj.h"
  43. #include "module.h"
  44. #include "value.h"
  45. #include "num.h"
  46. #include "vec.h"
  47. #include "sym.h"
  48. #include "error.h"
  49. #include "type.h"
  50. #include "brkpt.h"
  51. #include "interp.h"
  52. #include "../comp/byteops.h"
  53.  
  54. obj_t obj_ComponentClass = 0;
  55.  
  56. static struct variable *plus_var = NULL;
  57. static struct variable *minus_var = NULL;
  58. static struct variable *lt_var = NULL;
  59. static struct variable *le_var = NULL;
  60. static struct variable *eq_var = NULL;
  61. static struct variable *ne_var = NULL;
  62.  
  63.  
  64. /* Various utility routines. */
  65.  
  66. inline static int decode_byte(struct thread *thread)
  67. {
  68.     return ((unsigned char *)(thread->component))[thread->pc++];
  69. }
  70.  
  71. inline static int decode_int4(struct thread *thread)
  72. {
  73.     int byte1 = decode_byte(thread);
  74.     int byte2 = decode_byte(thread);
  75.     int byte3 = decode_byte(thread);
  76.     int byte4 = decode_byte(thread);
  77.  
  78.     return byte1 | (byte2 << 8) | (byte3 << 16) | (byte4 << 24);
  79. }
  80.  
  81. inline static int decode_arg(struct thread *thread)
  82. {
  83.     int arg = decode_byte(thread);
  84.  
  85.     if (arg == 0xff)
  86.     return decode_int4(thread);
  87.     else
  88.     return arg;
  89. }
  90.  
  91. static void canonicalize_values(struct thread *thread, obj_t *old_sp,
  92.                 obj_t *vals)
  93. {
  94.     int supplied = thread->sp - vals;
  95.     int wants = decode_arg(thread);
  96.     int fixed;
  97.     boolean restp;
  98.     int i;
  99.  
  100.     fixed = wants >> 1;
  101.     restp = wants & 1;
  102.  
  103.     if (supplied <= fixed) {
  104.     if (old_sp != vals)
  105.         for (i = 0; i < supplied; i++)
  106.         *old_sp++ = *vals++;
  107.     else {
  108.         i = supplied;
  109.         old_sp += supplied;
  110.     }
  111.     while (i < fixed) {
  112.         *old_sp++ = obj_False;
  113.         i++;
  114.     }
  115.     if (restp)
  116.         *old_sp++ = make_vector(0, NULL);
  117.     }
  118.     else {
  119.     if (old_sp != vals)
  120.         for (i = 0; i < fixed; i++)
  121.         *old_sp++ = *vals++;
  122.     else
  123.         vals += fixed;
  124.     if (restp)
  125.         *old_sp++ = make_vector(supplied - fixed, vals);
  126.     }
  127.  
  128.     thread->sp = old_sp;
  129. }
  130.  
  131.  
  132.  
  133. /* Various byte ops. */
  134.  
  135. static void op_flame(int byte, struct thread *thread)
  136. {
  137.     lose("Bogus byte-op: %d", byte);
  138. }
  139.  
  140. static void op_breakpoint(int byte, struct thread *thread)
  141. {
  142.     handle_byte_breakpoint(thread);
  143. }
  144.  
  145. static void op_return_single(int byte, struct thread *thread)
  146. {
  147.     do_return(thread, pop_linkage(thread), thread->sp - 1);
  148. }
  149.  
  150. static void op_make_value_cell(int byte, struct thread *thread)
  151. {
  152.     thread->sp[-1] = make_value_cell(thread->sp[-1]);
  153. }
  154.  
  155. static void op_value_cell_ref(int byte, struct thread *thread)
  156. {
  157.     thread->sp[-1] = value_cell_ref(thread->sp[-1]);
  158. }
  159.  
  160. static void op_value_cell_set(int byte, struct thread *thread)
  161. {
  162.     obj_t *sp = thread->sp;
  163.     value_cell_set(sp[-1], sp[-2]);
  164.     thread->sp = sp - 2;
  165. }
  166.  
  167. static void op_make_method(int byte, struct thread *thread)
  168. {
  169.     obj_t *sp = thread->sp;
  170.     obj_t method_info = sp[-4];
  171.     obj_t specializers = sp[-3];
  172.     obj_t result_types = sp[-2];
  173.     obj_t rest_results_type = sp[-1];
  174.     int n_closure_vars
  175.     = obj_ptr(struct method_info *, method_info)->n_closure_vars;
  176.     obj_t *lexenv = sp - n_closure_vars - 4;
  177.     obj_t method = make_byte_method(method_info, specializers, result_types,
  178.                     rest_results_type, lexenv);
  179.  
  180.     lexenv[0] = method;
  181.     thread->sp = lexenv+1;
  182. }
  183.  
  184. static void op_check_type(int byte, struct thread *thread)
  185. {
  186.     obj_t *sp = thread->sp;
  187.     obj_t value = sp[-2];
  188.     obj_t type = sp[-1];
  189.  
  190.     if (!instancep(value, type))
  191.     type_error(value, type);
  192.  
  193.     thread->sp = sp - 1;
  194. }
  195.  
  196. static void op_check_type_function(int byte, struct thread *thread)
  197. {
  198.     if (!instancep(thread->sp[-1], obj_FunctionClass))
  199.     type_error(thread->sp[-1], obj_FunctionClass);
  200. }
  201.  
  202. static void op_canonicalize_value(int byte, struct thread *thread)
  203. {
  204.     obj_t *vals = thread->sp - 1;
  205.  
  206.     canonicalize_values(thread, vals, vals);
  207. }
  208.  
  209. static void op_push_byte(int byte, struct thread *thread)
  210. {
  211.     signed char value = decode_byte(thread);
  212.     *thread->sp++ = make_fixnum(value);
  213. }
  214.  
  215. static void op_push_int(int byte, struct thread *thread)
  216. {
  217.     *thread->sp++ = make_fixnum(decode_int4(thread));
  218. }
  219.  
  220. static void op_conditional_branch(int byte, struct thread *thread)
  221. {
  222.     if (*--thread->sp == obj_False) {
  223.     int disp = decode_int4(thread);
  224.     thread->pc += disp;
  225.     }
  226.     else
  227.     thread->pc += 4;
  228. }
  229.  
  230. static void op_branch(int byte, struct thread *thread)
  231. {
  232.     int disp = decode_int4(thread);
  233.     thread->pc += disp;
  234. }
  235.  
  236. static void op_push_nil(int byte, struct thread *thread)
  237. {
  238.     *thread->sp++ = obj_Nil;
  239. }
  240.  
  241. static void op_push_unbound(int byte, struct thread *thread)
  242. {
  243.     *thread->sp++ = obj_Unbound;
  244. }
  245.  
  246. static void op_push_true(int byte, struct thread *thread)
  247. {
  248.     *thread->sp++ = obj_True;
  249. }
  250.  
  251. static void op_push_false(int byte, struct thread *thread)
  252. {
  253.     *thread->sp++ = obj_False;
  254. }
  255.  
  256. static void op_dup(int byte, struct thread *thread)
  257. {
  258.     obj_t *sp = thread->sp;
  259.     obj_t value = sp[-1];
  260.  
  261.     thread->sp = sp+1;
  262.     sp[0] = value;
  263. }
  264.  
  265. static void op_dot_tail(int byte, struct thread *thread)
  266. {
  267.     obj_t *sp = thread->sp;
  268.     obj_t arg = sp[-2];
  269.     obj_t func = sp[-1];
  270.     obj_t *old_sp = pop_linkage(thread);
  271.  
  272.     old_sp[0] = func;
  273.     old_sp[1] = arg;
  274.     thread->sp = old_sp + 2;
  275.  
  276.     invoke(thread, 1);
  277. }
  278.  
  279. static void op_dot(int byte, struct thread *thread)
  280. {
  281.     obj_t *sp = thread->sp;
  282.     obj_t arg = sp[-2];
  283.     obj_t func = sp[-1];
  284.  
  285.     sp[-2] = func;
  286.     sp[-1] = arg;
  287.  
  288.     invoke(thread, 1);
  289. }    
  290.  
  291. static void push_constant(struct thread *thread, int arg)
  292. {
  293.     *thread->sp++
  294.     = COMPONENT(thread->component)->constant[arg];
  295. }
  296.  
  297. static void op_push_constant_immed(int byte, struct thread *thread)
  298. {
  299.     push_constant(thread, byte & 0x0f);
  300. }
  301.  
  302. static void op_push_constant(int byte, struct thread *thread)
  303. {
  304.     push_constant(thread, decode_arg(thread));
  305. }
  306.  
  307. static void push_arg(struct thread *thread, int arg)
  308. {
  309.     *thread->sp++ = thread->fp[-5 - arg];
  310. }
  311.  
  312. static void op_push_arg_immed(int byte, struct thread *thread)
  313. {
  314.     push_arg(thread, byte & 0x0f);
  315. }
  316.  
  317. static void op_push_arg(int byte, struct thread *thread)
  318. {
  319.     push_arg(thread, decode_arg(thread));
  320. }
  321.  
  322. static void pop_arg(struct thread *thread, int arg)
  323. {
  324.     thread->fp[-5 - arg] = *--thread->sp;
  325. }
  326.  
  327. static void op_pop_arg_immed(int byte, struct thread *thread)
  328. {
  329.     pop_arg(thread, byte & 0x0f);
  330. }
  331.  
  332. static void op_pop_arg(int byte, struct thread *thread)
  333. {
  334.     pop_arg(thread, decode_arg(thread));
  335. }
  336.  
  337. static void push_local(struct thread *thread, int arg)
  338. {
  339.     *thread->sp++ = thread->fp[arg];
  340. }
  341.  
  342. static void op_push_local_immed(int byte, struct thread *thread)
  343. {
  344.     push_local(thread, byte & 0x0f);
  345. }
  346.  
  347. static void op_push_local(int byte, struct thread *thread)
  348. {
  349.     push_local(thread, decode_arg(thread));
  350. }
  351.  
  352. static void pop_local(struct thread *thread, int arg)
  353. {
  354.     thread->fp[arg] = *--thread->sp;
  355. }
  356.  
  357. static void op_pop_local_immed(int byte, struct thread *thread)
  358. {
  359.     pop_local(thread, byte & 0x0f);
  360. }
  361.  
  362. static void op_pop_local(int byte, struct thread *thread)
  363. {
  364.     pop_local(thread, decode_arg(thread));
  365. }
  366.  
  367. static void call_tail(struct thread *thread, int arg)
  368. {
  369.     obj_t *sp = thread->sp;
  370.     obj_t *stuff = sp - arg - 1;
  371.     obj_t *old_sp = pop_linkage(thread);
  372.  
  373.     while (stuff < sp)
  374.     *old_sp++ = *stuff++;
  375.  
  376.     thread->sp = old_sp;
  377.  
  378.     invoke(thread, arg);
  379. }
  380.  
  381. static void op_call_tail_immed(int byte, struct thread *thread)
  382. {
  383.     call_tail(thread, byte & 0x0f);
  384. }
  385.  
  386. static void op_call_tail(int byte, struct thread *thread)
  387. {
  388.     call_tail(thread, decode_arg(thread));
  389. }
  390.  
  391. static void op_call_immed(int byte, struct thread *thread)
  392. {
  393.     invoke(thread, byte & 0x0f);
  394. }
  395.  
  396. static void op_call(int byte, struct thread *thread)
  397. {
  398.     int nargs = decode_arg(thread);
  399.     thread->pc++;
  400.     invoke(thread, nargs);
  401. }
  402.  
  403. static void push_value(struct thread *thread, int arg)
  404. {
  405.     struct variable *var
  406.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  407.     obj_t value = var->value;
  408.  
  409.     if (value != obj_Unbound)
  410.     *thread->sp++ = value;
  411.     else
  412.     error("Unbound variable: %s", var->name);
  413. }
  414.  
  415. static void op_push_value_immed(int byte, struct thread *thread)
  416. {
  417.     push_value(thread, byte & 0xf);
  418. }
  419.  
  420. static void op_push_value(int byte, struct thread *thread)
  421. {
  422.     push_value(thread, decode_arg(thread));
  423. }
  424.  
  425. static void push_function(struct thread *thread, int arg)
  426. {
  427.     struct variable *var
  428.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  429.     obj_t value = var->value;
  430.  
  431.     switch (var->function) {
  432.       case func_No:
  433.     type_error(value, obj_FunctionClass);
  434.       case func_Yes:
  435.       case func_Always:
  436.     break;
  437.       case func_Maybe:
  438.     if (instancep(value, obj_FunctionClass)) {
  439.         var->function = func_Yes;
  440.         break;
  441.     }
  442.     else if (value == obj_Unbound)
  443.         error("Unbound variable: %s", var->name);
  444.     else {
  445.         var->function = func_No;
  446.         type_error(value, obj_FunctionClass);
  447.     }
  448.     }
  449.  
  450.     *thread->sp++ = value;
  451. }
  452.  
  453. static void op_push_function_immed(int byte, struct thread *thread)
  454. {
  455.     push_function(thread, byte & 0xf);
  456. }
  457.  
  458. static void op_push_function(int byte, struct thread *thread)
  459. {
  460.     push_function(thread, decode_arg(thread));
  461. }
  462.  
  463. static void pop_value(struct thread *thread, int arg)
  464. {
  465.     struct variable *var
  466.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  467.     obj_t value = *--thread->sp;
  468.  
  469.     if (var->type != obj_False && !instancep(value, var->type))
  470.     type_error(value, var->type);
  471.     if (var->function != func_Always)
  472.     var->function = func_Maybe;
  473.     var->value = value;
  474. }
  475.  
  476. static void op_pop_value_immed(int byte, struct thread *thread)
  477. {
  478.     pop_value(thread, byte & 0xf);
  479. }
  480.  
  481. static void op_pop_value(int byte, struct thread *thread)
  482. {
  483.     pop_value(thread, decode_arg(thread));
  484. }
  485.  
  486. static void op_plus(int byte, struct thread *thread)
  487. {
  488.     obj_t *sp = thread->sp;
  489.     obj_t x = sp[-2];
  490.     obj_t y = sp[-1];
  491.  
  492.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  493.     sp[-2] = make_fixnum(fixnum_value(x) + fixnum_value(y));
  494.     thread->sp = sp-1;
  495.     }
  496.     else {
  497.     thread->sp = sp+1;
  498.     sp[-2] = plus_var->value;
  499.     sp[-1] = x;
  500.     sp[0] = y;
  501.     invoke(thread, 2);
  502.     }
  503. }
  504.  
  505. static void op_minus(int byte, struct thread *thread)
  506. {
  507.     obj_t *sp = thread->sp;
  508.     obj_t x = sp[-2];
  509.     obj_t y = sp[-1];
  510.  
  511.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  512.     sp[-2] = make_fixnum(fixnum_value(x) - fixnum_value(y));
  513.     thread->sp = sp-1;
  514.     }
  515.     else {
  516.     thread->sp = sp+1;
  517.     sp[-2] = minus_var->value;
  518.     sp[-1] = x;
  519.     sp[0] = y;
  520.     invoke(thread, 2);
  521.     }
  522. }
  523.  
  524. static void op_lt(int byte, struct thread *thread)
  525. {
  526.     obj_t *sp = thread->sp;
  527.     obj_t x = sp[-2];
  528.     obj_t y = sp[-1];
  529.  
  530.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  531.     sp[-2] = ((long)x < (long)y) ? obj_True : obj_False;
  532.     thread->sp = sp-1;
  533.     }
  534.     else {
  535.     thread->sp = sp+1;
  536.     sp[-2] = lt_var->value;
  537.     sp[-1] = x;
  538.     sp[0] = y;
  539.     invoke(thread, 2);
  540.     }
  541. }
  542.  
  543. static void op_le(int byte, struct thread *thread)
  544. {
  545.     obj_t *sp = thread->sp;
  546.     obj_t x = sp[-2];
  547.     obj_t y = sp[-1];
  548.  
  549.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  550.     sp[-2] = ((long)x <= (long)y) ? obj_True : obj_False;
  551.     thread->sp = sp-1;
  552.     }
  553.     else {
  554.     thread->sp = sp+1;
  555.     sp[-2] = le_var->value;
  556.     sp[-1] = x;
  557.     sp[0] = y;
  558.     invoke(thread, 2);
  559.     }
  560. }
  561.  
  562. static void op_eq(int byte, struct thread *thread)
  563. {
  564.     obj_t *sp = thread->sp;
  565.     obj_t x = sp[-2];
  566.     obj_t y = sp[-1];
  567.  
  568.     if (x == y) {
  569.     sp[-2] = obj_True;
  570.     thread->sp = sp-1;
  571.     }
  572.     else if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  573.     sp[-2] = obj_False;
  574.     thread->sp = sp-1;
  575.     }
  576.     else {
  577.     thread->sp = sp+1;
  578.     sp[-2] = eq_var->value;
  579.     sp[-1] = x;
  580.     sp[0] = y;
  581.     invoke(thread, 2);
  582.     }
  583. }
  584.  
  585. static void op_idp(int byte, struct thread *thread)
  586. {
  587.     obj_t *sp = thread->sp;
  588.     obj_t x = sp[-2];
  589.     obj_t y = sp[-1];
  590.  
  591.     if (x == y)
  592.     sp[-2] = obj_True;
  593.     else if (obj_is_fixnum(x) || obj_is_fixnum(y))
  594.     sp[-2] = obj_False;
  595.     else if (idp(x, y))
  596.     sp[-2] = obj_True;
  597.     else
  598.     sp[-2] = obj_False;
  599.  
  600.     thread->sp = sp-1;
  601. }
  602.  
  603. static void op_ne(int byte, struct thread *thread)
  604. {
  605.     obj_t *sp = thread->sp;
  606.     obj_t x = sp[-2];
  607.     obj_t y = sp[-1];
  608.  
  609.     if (x == y) {
  610.     sp[-2] = obj_False;
  611.     thread->sp = sp-1;
  612.     }
  613.     else if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  614.     sp[-2] = obj_True;
  615.     thread->sp = sp-1;
  616.     }
  617.     else {
  618.     thread->sp = sp+1;
  619.     sp[-2] = ne_var->value;
  620.     sp[-1] = x;
  621.     sp[0] = y;
  622.     invoke(thread, 2);
  623.     }
  624. }
  625.  
  626. static void op_ge(int byte, struct thread *thread)
  627. {
  628.     obj_t *sp = thread->sp;
  629.     obj_t x = sp[-2];
  630.     obj_t y = sp[-1];
  631.  
  632.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  633.     sp[-2] = ((long)x >= (long)y) ? obj_True : obj_False;
  634.     thread->sp = sp-1;
  635.     }
  636.     else {
  637.     thread->sp = sp+1;
  638.     sp[-2] = le_var->value;
  639.     /* sp[-1] already holds y */
  640.     sp[0] = x;
  641.     invoke(thread, 2);
  642.     }
  643. }
  644.  
  645. static void op_gt(int byte, struct thread *thread)
  646. {
  647.     obj_t *sp = thread->sp;
  648.     obj_t x = sp[-2];
  649.     obj_t y = sp[-1];
  650.  
  651.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  652.     sp[-2] = ((long)x > (long)y) ? obj_True : obj_False;
  653.     thread->sp = sp-1;
  654.     }
  655.     else {
  656.     thread->sp = sp+1;
  657.     sp[-2] = lt_var->value;
  658.     /* sp[-1] already holds y */
  659.     sp[0] = x;
  660.     invoke(thread, 2);
  661.     }
  662. }
  663.  
  664. void interpret_byte(int byte, struct thread *thread)
  665. {
  666.     switch (byte) {
  667.       case op_BREAKPOINT:
  668.     op_breakpoint(byte, thread);
  669.     break;
  670.       case op_RETURN_SINGLE:
  671.     op_return_single(byte, thread);
  672.     break;
  673.       case op_MAKE_VALUE_CELL:
  674.     op_make_value_cell(byte, thread);
  675.     break;
  676.       case op_VALUE_CELL_REF:
  677.     op_value_cell_ref(byte, thread);
  678.     break;
  679.       case op_VALUE_CELL_SET:
  680.     op_value_cell_set(byte, thread);
  681.     break;
  682.       case op_MAKE_METHOD:
  683.     op_make_method(byte, thread);
  684.     break;
  685.       case op_CHECK_TYPE:
  686.     op_check_type(byte, thread);
  687.     break;
  688.       case op_CHECK_TYPE_FUNCTION:
  689.     op_check_type_function(byte, thread);
  690.     break;
  691.       case op_CANONICALIZE_VALUE:
  692.     op_canonicalize_value(byte, thread);
  693.     break;
  694.       case op_PUSH_BYTE:
  695.     op_push_byte(byte, thread);
  696.     break;
  697.       case op_PUSH_INT:
  698.     op_push_int(byte, thread);
  699.     break;
  700.       case op_CONDITIONAL_BRANCH:
  701.     op_conditional_branch(byte, thread);
  702.     break;
  703.       case op_BRANCH:
  704.     op_branch(byte, thread);
  705.     break;
  706.       case op_PUSH_NIL:
  707.     op_push_nil(byte, thread);
  708.     break;
  709.       case op_PUSH_UNBOUND:
  710.     op_push_unbound(byte, thread);
  711.     break;
  712.       case op_PUSH_TRUE:
  713.     op_push_true(byte, thread);
  714.     break;
  715.       case op_PUSH_FALSE:
  716.     op_push_false(byte, thread);
  717.     break;
  718.       case op_DUP:
  719.     op_dup(byte, thread);
  720.     break;
  721.       case op_DOT_TAIL:
  722.     op_dot_tail(byte, thread);
  723.     break;
  724.       case op_DOT_FOR_SINGLE:
  725.       case op_DOT_FOR_MANY:
  726.     op_dot(byte, thread);
  727.     break;
  728.       case op_PUSH_CONSTANT|0:
  729.       case op_PUSH_CONSTANT|1:
  730.       case op_PUSH_CONSTANT|2:
  731.       case op_PUSH_CONSTANT|3:
  732.       case op_PUSH_CONSTANT|4:
  733.       case op_PUSH_CONSTANT|5:
  734.       case op_PUSH_CONSTANT|6:
  735.       case op_PUSH_CONSTANT|7:
  736.       case op_PUSH_CONSTANT|8:
  737.       case op_PUSH_CONSTANT|9:
  738.       case op_PUSH_CONSTANT|10:
  739.       case op_PUSH_CONSTANT|11:
  740.       case op_PUSH_CONSTANT|12:
  741.       case op_PUSH_CONSTANT|13:
  742.       case op_PUSH_CONSTANT|14:
  743.     op_push_constant_immed(byte, thread);
  744.     break;
  745.       case op_PUSH_CONSTANT|15:
  746.     op_push_constant(byte, thread);
  747.     break;
  748.       case op_PUSH_ARG|0:
  749.       case op_PUSH_ARG|1:
  750.       case op_PUSH_ARG|2:
  751.       case op_PUSH_ARG|3:
  752.       case op_PUSH_ARG|4:
  753.       case op_PUSH_ARG|5:
  754.       case op_PUSH_ARG|6:
  755.       case op_PUSH_ARG|7:
  756.       case op_PUSH_ARG|8:
  757.       case op_PUSH_ARG|9:
  758.       case op_PUSH_ARG|10:
  759.       case op_PUSH_ARG|11:
  760.       case op_PUSH_ARG|12:
  761.       case op_PUSH_ARG|13:
  762.       case op_PUSH_ARG|14:
  763.     op_push_arg_immed(byte, thread);
  764.     break;
  765.       case op_PUSH_ARG|15:
  766.     op_push_arg(byte, thread);
  767.     break;
  768.       case op_POP_ARG|0:
  769.       case op_POP_ARG|1:
  770.       case op_POP_ARG|2:
  771.       case op_POP_ARG|3:
  772.       case op_POP_ARG|4:
  773.       case op_POP_ARG|5:
  774.       case op_POP_ARG|6:
  775.       case op_POP_ARG|7:
  776.       case op_POP_ARG|8:
  777.       case op_POP_ARG|9:
  778.       case op_POP_ARG|10:
  779.       case op_POP_ARG|11:
  780.       case op_POP_ARG|12:
  781.       case op_POP_ARG|13:
  782.       case op_POP_ARG|14:
  783.     op_pop_arg_immed(byte, thread);
  784.     break;
  785.       case op_POP_ARG|15:
  786.     op_pop_arg(byte, thread);
  787.     break;
  788.       case op_PUSH_LOCAL|0:
  789.       case op_PUSH_LOCAL|1:
  790.       case op_PUSH_LOCAL|2:
  791.       case op_PUSH_LOCAL|3:
  792.       case op_PUSH_LOCAL|4:
  793.       case op_PUSH_LOCAL|5:
  794.       case op_PUSH_LOCAL|6:
  795.       case op_PUSH_LOCAL|7:
  796.       case op_PUSH_LOCAL|8:
  797.       case op_PUSH_LOCAL|9:
  798.       case op_PUSH_LOCAL|10:
  799.       case op_PUSH_LOCAL|11:
  800.       case op_PUSH_LOCAL|12:
  801.       case op_PUSH_LOCAL|13:
  802.       case op_PUSH_LOCAL|14:
  803.     op_push_local_immed(byte, thread);
  804.     break;
  805.       case op_PUSH_LOCAL|15:
  806.     op_push_local(byte, thread);
  807.     break;
  808.       case op_POP_LOCAL|0:
  809.       case op_POP_LOCAL|1:
  810.       case op_POP_LOCAL|2:
  811.       case op_POP_LOCAL|3:
  812.       case op_POP_LOCAL|4:
  813.       case op_POP_LOCAL|5:
  814.       case op_POP_LOCAL|6:
  815.       case op_POP_LOCAL|7:
  816.       case op_POP_LOCAL|8:
  817.       case op_POP_LOCAL|9:
  818.       case op_POP_LOCAL|10:
  819.       case op_POP_LOCAL|11:
  820.       case op_POP_LOCAL|12:
  821.       case op_POP_LOCAL|13:
  822.       case op_POP_LOCAL|14:
  823.     op_pop_local_immed(byte, thread);
  824.     break;
  825.       case op_POP_LOCAL|15:
  826.     op_pop_local(byte, thread);
  827.     break;
  828.       case op_CALL_TAIL|0:
  829.       case op_CALL_TAIL|1:
  830.       case op_CALL_TAIL|2:
  831.       case op_CALL_TAIL|3:
  832.       case op_CALL_TAIL|4:
  833.       case op_CALL_TAIL|5:
  834.       case op_CALL_TAIL|6:
  835.       case op_CALL_TAIL|7:
  836.       case op_CALL_TAIL|8:
  837.       case op_CALL_TAIL|9:
  838.       case op_CALL_TAIL|10:
  839.       case op_CALL_TAIL|11:
  840.       case op_CALL_TAIL|12:
  841.       case op_CALL_TAIL|13:
  842.       case op_CALL_TAIL|14:
  843.     op_call_tail_immed(byte, thread);
  844.     break;
  845.       case op_CALL_TAIL|15:
  846.     op_call_tail(byte, thread);
  847.     break;
  848.       case op_CALL_FOR_MANY|0:
  849.       case op_CALL_FOR_MANY|1:
  850.       case op_CALL_FOR_MANY|2:
  851.       case op_CALL_FOR_MANY|3:
  852.       case op_CALL_FOR_MANY|4:
  853.       case op_CALL_FOR_MANY|5:
  854.       case op_CALL_FOR_MANY|6:
  855.       case op_CALL_FOR_MANY|7:
  856.       case op_CALL_FOR_MANY|8:
  857.       case op_CALL_FOR_MANY|9:
  858.       case op_CALL_FOR_MANY|10:
  859.       case op_CALL_FOR_MANY|11:
  860.       case op_CALL_FOR_MANY|12:
  861.       case op_CALL_FOR_MANY|13:
  862.       case op_CALL_FOR_MANY|14:
  863.       case op_CALL_FOR_SINGLE|0:
  864.       case op_CALL_FOR_SINGLE|1:
  865.       case op_CALL_FOR_SINGLE|2:
  866.       case op_CALL_FOR_SINGLE|3:
  867.       case op_CALL_FOR_SINGLE|4:
  868.       case op_CALL_FOR_SINGLE|5:
  869.       case op_CALL_FOR_SINGLE|6:
  870.       case op_CALL_FOR_SINGLE|7:
  871.       case op_CALL_FOR_SINGLE|8:
  872.       case op_CALL_FOR_SINGLE|9:
  873.       case op_CALL_FOR_SINGLE|10:
  874.       case op_CALL_FOR_SINGLE|11:
  875.       case op_CALL_FOR_SINGLE|12:
  876.       case op_CALL_FOR_SINGLE|13:
  877.       case op_CALL_FOR_SINGLE|14:
  878.     op_call_immed(byte, thread);
  879.     break;
  880.       case op_CALL_FOR_MANY|15:
  881.       case op_CALL_FOR_SINGLE|15:
  882.     op_call(byte, thread);
  883.     break;
  884.       case op_PUSH_VALUE|0:
  885.       case op_PUSH_VALUE|1:
  886.       case op_PUSH_VALUE|2:
  887.       case op_PUSH_VALUE|3:
  888.       case op_PUSH_VALUE|4:
  889.       case op_PUSH_VALUE|5:
  890.       case op_PUSH_VALUE|6:
  891.       case op_PUSH_VALUE|7:
  892.       case op_PUSH_VALUE|8:
  893.       case op_PUSH_VALUE|9:
  894.       case op_PUSH_VALUE|10:
  895.       case op_PUSH_VALUE|11:
  896.       case op_PUSH_VALUE|12:
  897.       case op_PUSH_VALUE|13:
  898.       case op_PUSH_VALUE|14:
  899.     op_push_value_immed(byte, thread);
  900.     break;
  901.       case op_PUSH_VALUE|15:
  902.     op_push_value(byte, thread);
  903.     break;
  904.       case op_PUSH_FUNCTION|0:
  905.       case op_PUSH_FUNCTION|1:
  906.       case op_PUSH_FUNCTION|2:
  907.       case op_PUSH_FUNCTION|3:
  908.       case op_PUSH_FUNCTION|4:
  909.       case op_PUSH_FUNCTION|5:
  910.       case op_PUSH_FUNCTION|6:
  911.       case op_PUSH_FUNCTION|7:
  912.       case op_PUSH_FUNCTION|8:
  913.       case op_PUSH_FUNCTION|9:
  914.       case op_PUSH_FUNCTION|10:
  915.       case op_PUSH_FUNCTION|11:
  916.       case op_PUSH_FUNCTION|12:
  917.       case op_PUSH_FUNCTION|13:
  918.       case op_PUSH_FUNCTION|14:
  919.     op_push_function_immed(byte, thread);
  920.     break;
  921.       case op_PUSH_FUNCTION|15:
  922.     op_push_function(byte, thread);
  923.     break;
  924.       case op_POP_VALUE|0:
  925.       case op_POP_VALUE|1:
  926.       case op_POP_VALUE|2:
  927.       case op_POP_VALUE|3:
  928.       case op_POP_VALUE|4:
  929.       case op_POP_VALUE|5:
  930.       case op_POP_VALUE|6:
  931.       case op_POP_VALUE|7:
  932.       case op_POP_VALUE|8:
  933.       case op_POP_VALUE|9:
  934.       case op_POP_VALUE|10:
  935.       case op_POP_VALUE|11:
  936.       case op_POP_VALUE|12:
  937.       case op_POP_VALUE|13:
  938.       case op_POP_VALUE|14:
  939.     op_pop_value_immed(byte, thread);
  940.     break;
  941.       case op_POP_VALUE|15:
  942.     op_pop_value(byte, thread);
  943.     break;
  944.       case op_PLUS:
  945.     op_plus(byte, thread);
  946.     break;
  947.       case op_MINUS:
  948.     op_minus(byte, thread);
  949.     break;
  950.       case op_LT:
  951.     op_lt(byte, thread);
  952.     break;
  953.       case op_LE:
  954.     op_le(byte, thread);
  955.     break;
  956.       case op_EQ:
  957.     op_eq(byte, thread);
  958.     break;
  959.       case op_IDP:
  960.     op_idp(byte, thread);
  961.     break;
  962.       case op_NE:
  963.     op_ne(byte, thread);
  964.     break;
  965.       case op_GE:
  966.     op_ge(byte, thread);
  967.     break;
  968.       case op_GT:
  969.     op_gt(byte, thread);
  970.     break;
  971.       default:
  972.     op_flame(byte, thread);
  973.     }
  974. }
  975.  
  976. void interpret_next_byte(struct thread *thread)
  977. {
  978.     interpret_byte(decode_byte(thread), thread);
  979. }
  980.  
  981.  
  982.  
  983. /* Entry points into the interpteter. */
  984.  
  985. void set_byte_continuation(struct thread *thread, obj_t component)
  986. {
  987.     int n_const = COMPONENT(component)->n_constants;
  988.     thread->component = component;
  989.     thread->pc = (char *)(&COMPONENT(component)->constant[n_const])
  990.     - (char *)component;
  991.     thread->sp = thread->fp + COMPONENT(component)->frame_size;
  992. #if SLOW_FUNCTION_POINTERS
  993.     thread->advance = NULL;
  994. #else
  995.     thread->advance = interpret_next_byte;
  996. #endif    
  997. }
  998.  
  999. void do_byte_return(struct thread *thread, obj_t *old_sp, obj_t *vals)
  1000. {
  1001.     int opcode = ((unsigned char *)(thread->component))[thread->pc - 1];
  1002.  
  1003.     if (opcode == op_BREAKPOINT)
  1004.     opcode = original_byte(thread->component, thread->pc - 1);
  1005.  
  1006.     if ((opcode&0xf0) == op_CALL_FOR_SINGLE || opcode == op_DOT_FOR_SINGLE
  1007.       || opcode >= op_PLUS) {
  1008.     if (vals == thread->sp)
  1009.         *old_sp = obj_False;
  1010.     else if (vals != old_sp)
  1011.         *old_sp = vals[0];
  1012.     thread->sp = old_sp + 1;
  1013.     }
  1014.     else if ((opcode&0xf0) == op_CALL_FOR_MANY || opcode == op_DOT_FOR_MANY)
  1015.     canonicalize_values(thread, old_sp, vals);
  1016.     else
  1017.     lose("Strange call opcode: 0x%02x", opcode);
  1018.  
  1019. #if SLOW_FUNCTION_POINTERS
  1020.     thread->advance = NULL;
  1021. #else
  1022.     thread->advance = interpret_next_byte;
  1023. #endif
  1024. }
  1025.  
  1026.  
  1027. /* Component allocation. */
  1028.  
  1029. obj_t make_component(obj_t debug_name, int frame_size, obj_t mtime,
  1030.              obj_t source_file, obj_t debug_info, int nconst,
  1031.              int nbytes)
  1032. {
  1033.     int len = sizeof(struct component) + sizeof(obj_t)*(nconst - 1) + nbytes;
  1034.     obj_t res = alloc(obj_ComponentClass, len);
  1035.     int i;
  1036.  
  1037.     COMPONENT(res)->length = len;
  1038.     COMPONENT(res)->debug_name = debug_name;
  1039.     COMPONENT(res)->frame_size = frame_size;
  1040.     COMPONENT(res)->mtime = mtime;
  1041.     COMPONENT(res)->source_file = source_file;
  1042.     COMPONENT(res)->debug_info = debug_info;
  1043.     COMPONENT(res)->n_constants = nconst;
  1044.  
  1045.     for (i = 0; i < nconst; i++)
  1046.     COMPONENT(res)->constant[i] = obj_Unbound;
  1047.  
  1048.     return res;
  1049. }
  1050.  
  1051.  
  1052. /* GC routines. */
  1053.  
  1054. static int scav_component(struct object *ptr)
  1055. {
  1056.     struct component *component = (struct component *)ptr;
  1057.     int i;
  1058.  
  1059.     scavenge(&component->debug_name);
  1060.     scavenge(&component->mtime);
  1061.     scavenge(&component->source_file);
  1062.     scavenge(&component->debug_info);
  1063.     for (i = 0; i < component->n_constants; i++)
  1064.     scavenge(component->constant + i);
  1065.  
  1066.     return component->length;
  1067. }
  1068.  
  1069. static obj_t trans_component(obj_t component)
  1070. {
  1071.     return transport(component, COMPONENT(component)->length);
  1072. }
  1073.  
  1074. void scavenge_interp_roots(void)
  1075. {
  1076.     scavenge(&obj_ComponentClass);
  1077. }
  1078.  
  1079.  
  1080. /* Init stuff. */
  1081.  
  1082. void make_interp_classes(void)
  1083. {
  1084.     obj_ComponentClass = make_builtin_class(scav_component, trans_component);
  1085. }
  1086.  
  1087. void init_interp_classes(void)
  1088. {
  1089.     init_builtin_class(obj_ComponentClass, "<component>",
  1090.                obj_ObjectClass, NULL);
  1091. }
  1092.  
  1093. void init_interpreter(void)
  1094. {
  1095.     plus_var = find_variable(module_BuiltinStuff, symbol("+"), FALSE, TRUE);
  1096.     minus_var = find_variable(module_BuiltinStuff, symbol("-"), FALSE, TRUE);
  1097.     lt_var = find_variable(module_BuiltinStuff, symbol("<"), FALSE, TRUE);
  1098.     le_var = find_variable(module_BuiltinStuff, symbol("<="), FALSE, TRUE);
  1099.     eq_var = find_variable(module_BuiltinStuff, symbol("="), FALSE, TRUE);
  1100.     ne_var = find_variable(module_BuiltinStuff, symbol("~="), FALSE, TRUE);
  1101. }
  1102.